home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / rkpls301.zip / RKPDEMO.ZIP / SAMPLE3.PAS < prev    next >
Pascal/Delphi Source File  |  1993-03-04  |  6KB  |  234 lines
  1. Program Sample3;
  2.  
  3. {
  4.  This is a demonstration program using RkPlus.
  5.  It uses 2 registration levels (0 and 1).
  6.  If a Level 1 key has expired, it will be treated as Level 0.
  7.  If a Level 0 key has expired, it will be treated as Unregistered.
  8.  This is a very simple program that doesn't actually do anything, but it
  9.  should demonstrate some of what can be done with RkPlus.
  10.  
  11.  It is identical to Sample1, except that it reads the registration
  12.  information from its own configuration file, instead of using the
  13.  RkPlus procedures GetRegInfo and SaveRegInfo (which use a .RKP file).
  14.  It uses the same keys as Sample1, which can be created with the GenKey
  15.  programme.
  16.  
  17.  Sample3 uses the example encoding unit Encode.
  18. }
  19.  
  20.  
  21. Uses
  22.   Crt,
  23.   RkPlus,
  24.   Encode;
  25.  
  26.  
  27. Const
  28.   MonthNames : Array[1..12] of String[3]
  29.   = ('Jan','Feb','Mar','Apr','May','Jun','Jul','Aug','Sep','Oct','Nov','Dec');
  30.  
  31.  
  32. Var
  33.   kc  : Char;
  34.   lcv : Byte;
  35.  
  36.  
  37. Procedure ReadConfig;
  38.  
  39. Var
  40.   cf : Text;
  41.   cs : String[80];
  42.  
  43. Begin
  44.   Assign(cf,'SAMPLE.CNF');
  45.   {$I-}
  46.   Reset(cf);
  47.   {$I+}
  48.   If (IoResult = 0) then Begin
  49.     While (Not Eof(cf)) Do Begin
  50.       ReadLn(cf,cs);
  51.       If (Copy(cs,1,1) <> '#') then Begin
  52.         If (Copy(cs,1,5) = 'NAME=') then
  53.           Rkp.Name1 := Copy(cs,6,80)
  54.         Else If (Copy(cs,1,6) = 'LEVEL=') then
  55.           If (Copy(cs,7,1) = 'R') then
  56.             Rkp.Level := 1
  57.           Else
  58.             Rkp.Level := 0
  59.         Else If (Copy(cs,1,4) = 'KEY=') then
  60.           Rkp.Key := Copy(cs,5,80);
  61.       End;
  62.     End;
  63.     If (Rkp.Key <> '000000000000') then Begin
  64.       Rkp.Name2 := '';
  65.       Rkp.Name3 := '';
  66.       Rkp.ExpYear := 0;
  67.       Rkp.ExpMonth := 0;
  68.       VerifyKey;
  69.     End;
  70.   End;
  71. End;
  72.  
  73.  
  74. Procedure BadRegBeep;
  75.  
  76. Begin
  77.   Sound(1200);
  78.   Delay(200);
  79.   Sound(600);
  80.   Delay(200);
  81.   Sound(1200);
  82.   Delay(200);
  83.   Sound(600);
  84.   Delay(200);
  85.   NoSound;
  86. End;
  87.  
  88.  
  89. Procedure NotRegBeep;
  90.  
  91. Begin
  92.   Sound(600);
  93.   Delay(200);
  94.   Sound(1200);
  95.   Delay(200);
  96.   NoSound;
  97. End;
  98.  
  99.  
  100. Procedure DoView;
  101.  
  102. Begin
  103.   WriteLn('Sample data :');
  104.   WriteLn;
  105.   WriteLn('4.465536  7.918270  0.118373  5.367233');
  106.   WriteLn('1.396349  4.868343  7.079323  4.783021');
  107.   WriteLn('3.947924  8.864673  8.846264  2.999999');
  108.   WriteLn('8.490832  6.874378  5.338329  3.729270');
  109.   WriteLn('6.839882  8.873478  6.750373  7.018948');
  110.   WriteLn('5.034784  3.003763  3.253290  4.892387');
  111.   WriteLn('3.874378  8.314159  9.880869  3.987842');
  112.   WriteLn('2.764947  9.265358  4.013002  9.903278');
  113. End;
  114.  
  115.  
  116. Procedure DoCalc;
  117.  
  118. Begin
  119.   If Rkp.Registered then Begin
  120.     Write('The calculated result is ');
  121.     WriteLn(4.465536+7.918270+0.118373+5.367233+1.396349+4.868343+7.079323+4.783021
  122.     +3.947924+8.864673+8.846264+2.999999+8.490832+6.874378+5.338329+3.729270
  123.     +6.839882+8.873478+6.750373+7.018948+5.034784+3.003763+3.253290+4.892387
  124.     +3.874378+8.314159+9.880869+3.987842+2.764947+9.265358+4.013002+9.903278);
  125.   End Else
  126.     WriteLn('Only available in registered version!');
  127. End;
  128.  
  129.  
  130. Procedure DoTest;
  131.  
  132. Begin
  133.   If Rkp.Registered then Begin
  134.     If (Rkp.Level > 0) then Begin
  135.       Write('Performing tests...');
  136.       Delay(300);
  137.       WriteLn;
  138.       WriteLn('All tests passed.');
  139.     End Else
  140.       WriteLn('Not available in demo version!');
  141.   End Else
  142.     WriteLn('Only available in registered version!');
  143. End;
  144.  
  145.  
  146. Begin
  147.   If BadSystemDate then Begin
  148.     WriteLn('You must correctly set your system clock to run Demo!');
  149.     BadRegBeep;
  150.     Halt(1);
  151.   End;
  152.   SetProgID('Sample');
  153.   ReadConfig;
  154.   Write('Sample3');
  155.   If Not RkpOK then
  156.     WriteLn(' [invalid]')
  157.   Else If Rkp.Registered and (Rkp.Level > 0) then
  158.     WriteLn(' [registered]')
  159.   Else If Rkp.Registered then
  160.     WriteLn(' [demo]')
  161.   Else
  162.     WriteLn(' [unregistered]');
  163.   WriteLn('Sample of RkPlus method 4 (with user-written encoding)');
  164.   WriteLn('see RKPLUS.DOC for more info');
  165.   WriteLn;
  166.   If (RkpError = InvalidFile) or (RkpError = InvalidKey) then Begin
  167.     WriteLn(KeyFileName,' has been altered!');
  168.     BadRegBeep;
  169.     Halt(1);
  170.   End Else If (RkpError = ExpiredKey) then Begin
  171.     If (Rkp.Level > 0) then Begin
  172.       WriteLn('Your registration key has expired!');
  173.       WriteLn('You will be given access at the DEMO level.');
  174.       NotRegBeep;
  175.       Rkp.Level := 0;
  176.     End Else Begin
  177.       WriteLn('Your limited use demo key has expired!');
  178.       WriteLn('You will be given access at the UNREGISTERED level.');
  179.       NotRegBeep;
  180.       Rkp.Registered := False;
  181.     End;
  182.   End Else If Rkp.Registered then Begin
  183.     If (Rkp.Level > 0) then Begin
  184.       WriteLn('This version of Sample3 is registered to ',Rkp.Name1);
  185.       If (Rkp.ExpYear <> 0) and (Rkp.ExpMonth <> 0) then
  186.         WriteLn('This registration will expire ','1-',MonthNames[Rkp.ExpMonth],'-',Rkp.ExpYear,'.');
  187.       WriteLn('Thank you for registering!');
  188.     End Else Begin
  189.       WriteLn('This version of Sample3 is a limited use demo for ',Rkp.Name1);
  190.       If (Rkp.ExpYear <> 0) and (Rkp.ExpMonth <> 0) then
  191.         WriteLn('This limited use demo will expire ','1-',MonthNames[Rkp.ExpMonth],'-',Rkp.ExpYear,'.');
  192.       WriteLn('Don''t forget to register!');
  193.     End;
  194.   End Else If Not RkpOK then Begin
  195.     WriteLn('Unexpected error ',RkpError,'!');
  196.     Halt(255);
  197.   End Else Begin
  198.     WriteLn('This version of Sample3 is unregistered.');
  199.     NotRegBeep;
  200.     Delay(500);
  201.   End;
  202.   WriteLn;
  203.   WriteLn('Sample3 Menu');
  204.   WriteLn;
  205.   WriteLn('[V]iew sample data');
  206.   Write('[C]alculate');
  207.   If Not Rkp.Registered then
  208.     WriteLn('  (only available in registered version)')
  209.   Else
  210.     WriteLn;
  211.   Write('[T]est results');
  212.   If Not Rkp.Registered then
  213.     WriteLn('  (only available in registered version)')
  214.   Else If (Rkp.Level <= 0) then
  215.     WriteLn('  (not available in demo version)')
  216.   Else
  217.     WriteLn;
  218.   WriteLn;
  219.   Write('Selection : ');
  220.   kc := UpCase(ReadKey);
  221.   WriteLn;
  222.   WriteLn;
  223.   Case kc of
  224.   'V' :
  225.     DoView;
  226.   'C' :
  227.     DoCalc;
  228.   'T' :
  229.     DoTest;
  230.   Else
  231.     WriteLn('Invalid selection!');
  232.   End;
  233. End.
  234.